perm filename NOTWRT.F4[XX,LCS]3 blob sn#185012 filedate 1975-11-04 generic text, type T, neo UTF8
00200		SUBROUTINE NOTWRT
00300		IMPLICIT INTEGER(A-Q,S-Z)
00400		COMMON/DL/IXRX,M,AA /FONT/JFONT 
00500		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
00600		DIMENSION RACNT(65),RDOT(7),XAC(7),RNOTE(22)
00650		1,RACCI(22),NACCI(3)
00700		REAL DIS,CENTR,POS,STFF
00800		COMMON /STF/RSTFAC(-3/4),RSTJ2
00900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01000		COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
01300	C   FOR NOTE DRAWING
01310		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01320		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
01330		1 PUNCT,RDIS,RJ
01400		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
01500		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01600		1,(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9))
01700		1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
01800		DATA RACNT/4.0,1000.005,17.0,0.105, 8.0,1003.0, 7.014, 11.0
01900		1,13. ,1000. ,0.010,14.01,14. ,17. ,1001.018,7. ,13.018,27.,
02000		1 1004., 4.002, 6.004, 8.004,10.002,10., 8.102,6.102,4.
02100		1,32.0,1000.0,14.0,1007.007,7.107, 43.0,1012.01,11.006,9.003
02200		1, 7.001, 5.0, 9.002, 13.006, 15.01, 10.004, 13.009, 52.0,
02300		1 1002.008,3.003, 5.001, 8.0, 10.0, 13.001, 15.003, 16.008,
02305		1 65.,1106.104, 0.002, 6.104, 12.002, 18.104, 24.002, 24.003,
02307		1 18.103, 12.003, 6.103, 0.003, 106.103/
02310	     1 ,RNOTE/ 1000., 5.007, 11.007, 16., 11.107, 5.107, 0.0,
02340	     1 1000.0, 7.007, 14.0, 7.107, 0,  1000.107, 14.007,
02370	     1 1014.107,0.007, 1000.003,4.107,6.007,9.107,11.007,14.103/
02400		DATA RDOT/1000.0, 0.103, 1.0, 1.103, 2.0, 2.103,0/
02500		1 , R5/5.0/, R66/66.0/, R72/72.0/,R18/18.0/,RSTM/14.54/
02600		1 ,XAC/9,14,18,28,33,44,53/
02700	C   ALL DATA NUMS OVER 90 GIVE INVISIBLE VECTORS
02800		DATA RACCI/6.0,1115.003, 110.007, 106.001,
02816	     1 115.109, 115.021, 15.0, 1104.104, 118.108,
02832	     1 1108.113, 108.016,  1104.008, 118.004,
02848	     1 1114.014, 114.115, 22.0,1106.117, 106.007, 114.004
02864	     1, 1114.018, 114.107, 106.104/
02880	     1 ,NACCI/1,7,16/
02890	
02900		RST7=7.*RSTJ2
03510		RST3=3.*RSTJ2
03520		RSTX=RSTJ2
03560	C  FOR MINIS AT 245
03600		RMINI=RSTJ2
03700	C  OR SHOULD THIS ONLY BE IN NOTES, ETC?  15/9/72
03800	
04100		RINV=1
04200		IF(JA.EQ.1)GO TO 11
04400		IF(JA.EQ.9)GO TO 242
04700	
04750	C  NEXT IS FOR RESTS
04760		IF(R8.NE.0)J5=-2
04780	C  R8 PUTS NUMBER OVER WHOLE REST ONLY.
04800		IF(J5.GT.1)R4=R4-2
04900	CC	RA=R4
05000		R7=R6*10.
05100	C  FOR DOTS
05200	202	CALL REST
05300		IF(J5.GT.1)GO TO 200
05400		IF(R7.EQ.0)RETURN
05900	201	RA=14
05950		R6=0
06000		IF(J5)RA=19
06100		R3=R3+RA*RSTJ2
06200		R4=8.+R4
06300		JA=9
06400		J5=7
06500	C   IF P6=1 THE REST IS DOTTED
06600		CALL CENTX
06650		GO TO 242
06700	200	J5=J5-1
06800	C  FOR MULTIPLE TAILS ON 16TH REST, ETC.
06900		R4=R4+2.
07000		CALL RJBX(4.3)
07100		GO TO 202
07200	
10200	29	RJX=R3
10300		RJY=CENTR+RSTJ2
10350	108	IF(WHOLE.NE.0)RJX=RJX+3.*RMINI
10375	C WHOLE=1 MEANS IT'S A WHOLE NOTE (WIDER THAN A HALF.)
10387		WHOLE=0
10400	107	CALL RDRAW(1,7.0,RDOT,RMINI,RJX,RJY,RMINI)
10410	C    ****   ****    ***  ↑↑↑↑↑↑↑↑↑↑ THESE WERE RSTJ2 11/74
10420		IF(JA.EQ.1)GO TO 290
10500		IF(R7.GE.20.)GO TO 290
10600		RB=POS+52.*RSTJ2
10700		IF(RJY.NE.RB)GO TO 6241
10800	C   WHERE IS RB USED LATER?
10900		RJY=RJY-12*RSTJ2
11000		GO TO 107
11100	C  ABOVE FOR DOTS
11200	290	R7=R7-10.
11300		IF(R7.LT.10.)GO TO 1342
11400		RJX=RJX+RSTJ2*10.
11500		GO TO 107
11600	
14300		GO TO 1121
14400	
14500	C  NOTES****
14600	11	JY=0
14610		IF(R6.EQ.0)GO TO 1015
14620		JY=IABS(J6)
14700		R6=ABS(AMOD(R6,1.0))*10.
14800	C   R6 WILL HAVE ACCENT CODE # (.7=DOT, ETC.)
14900	1015	L=IABS(J4)
15140		RJAC=R3
15160	C   TO SAVE POS. OF NOTE FOR ACCENT
15510		RZTM=2.*RSTJ2
15520		STEM=J5/10
15700		IF(L.LT.100)GO TO 1013
15800		IF(L.LT.200)GO TO 1012
15900		RZTM=0
16000		IF(L.GE.300)GO TO 1014
16010		KL=8
16100		RG=12.0
16200	C  FOR DIAMOND NOTES.
16300		GO TO 1017
16350	1014	IF(L.GE.400)GO TO 1016
16400		RJX=RMINI*7
16410	C  FOR "X" NOTES.
16500		KL=13
16600		RG=16.
16700		RB=CENTR+RJX
17000		IF(STEM.EQ.2)RB=CENTR-RJX
17100		GO TO 1017
17150	
17160	1016	RB=CENTR+R11*RST7
17165	C  FOR NO NOTE HEAD.  P11 CAN ADJUST SOURCE OF STEM.
17170		GO TO 1017
17180	
17200	1012	RMINI=.6*RSTJ2
17300	C  FOR RMINI NOTES
17400	1017	R4=AMOD(R4,100.)
17440	C  FOR MINI TAILS AND ACCIS. ETC.
17500	1013	J4=R4
17600		RJZ=R4
17650	C  RJZ FOR FLAT, #, NAT.   RX4 FOR TR., HARM, ETC.
17700		RX4=R4
17900		IF(JY.LT.10)GO TO 2221
18000		IF(JY.GE.30)GO TO 2221
18100	C P6 FOR HOMING TO RIGHT(10,30) OR LEFT(20) OF STEM(10,30=UP, 20=DOWN)
18200	C P6<0 = WHITE NOTE
18300		RQ=RSTM
18400		IF(J6)RQ=RQ+1.66
18500	C GETS WIDTH OF NOTE DISPLACEMENT
18600		IF(JY.EQ.20)RQ=-RQ
18700		R3=R3+RQ*RMINI
18710	2221	IF(J4.LE.1)GO TO 322
18800		IF(J4.LT.13)GO TO 1121
18850	
18860	322	IF(J9)GO TO 1121
18900	C   ARE THERE LEDGER LINES?  P9=-1 SUPPRESSES THEM.
19000		J11=(J4+1)/2-6
19100		IF(J11)J11=-((3-J4)/2)
19200	
19203	C  FOR LEDGER LINES
19212		RJW=R3-7.*RMINI
19215		RZ=R3+20.*RMINI
19218		IF(J11)GO TO 71
19221		JX=J11
19224		JRX=13
19227	C********* 18/9/72
19230		GO TO 711
19233	71	JX=-J11
19236		JRX=J11*2+3
19239	711	RX=POS-18*RSTJ2+RST7*JRX
19242	C********* 18/9/72
19245		IF(J6)RZ=RZ+2*RMINI
19248	C126	IF(PLT.EQ.-3)GO TO 1126
19251	C  FOR 2-PASS PLOTTING
19254	C   ******* ABOVE IS NOT USED, 15/9/72
19257	126	CALL LINX(RJW,RX,RZ,RX)
19260		IF(PLT.NE.-2)GO TO 1126
19263		RJY=RX-1./RHT
19266		CALL LINX(RJW,RJY,RZ,RJY)
19269	1126	IF(JX.EQ.1)GO TO 1122
19272		RX=RX+RSTJ2*14.
19275		JX=JX-1
19278		GO TO 126
19281	1122	J9=-1
19291	
19300	C  IF J6≠0 NOTE IS FILLED IN
19320	1121	IF(L.GE.400)GO TO 123
19360	C  JUMP IF NO NOTE HEAD
19380		IF(J6)GO TO 1322
19400		IF(L.LT.200)GO TO 125
19405	1322	IF(L.GE.200)GO TO 1253
19407	C  FOR DIAMOND AND X NOTES.
19410		KL=1
19420		RG=7.
19430	C  FOR WHITE NOTES ON DPY.
19440		WHOLE=MOD(J7,10)
19450		IF(WHOLE.EQ.0)GO TO 2122
19455		STEM=0
19460	C  FOR VARIOUS AUTOMATIC FEATURES IN 'SCORE' SECTION.
19470		J7=0
19490		R5=AMOD(R5,10.)
19495		J5=R5
19500	2122	IF(PLT.GE.0)GO TO 1253
19600		IF(L.GE.200)GO TO 1253
19805	2121	J5=15+WHOLE
19806	C  IF WHOLE=1, THEN WHOLE NOTE SHAPE INSTEAD OF HALF. (P7=1)
19807		RG=RSTJ2
19808	C FIX THIS SOME DAY↓↓  SEE 1342+1!
19810	CCXX	IF(RMINI.NE.RSTJ2)RSTJ2=.7*RSTJ2
19832	C  THESE NOTES ARE IN CLEF1.  1/2=13   WHOLE=14
19835		JX4=J4
19836		RQ=R7
19837	C  SAVE IT FOR DOTS
19840		CALL DRWNT(RMINI)
19841		R7=RQ
19842		J4=JX4
19843	C  GET IT BACK
19845		RSTJ2=RG
19850	C  DRAWS GOOD NOTES ON PLOTTER -- NOT ON DPY.
19860	CC  DONE IN DRWNT	R7=J7
19870	C  TO RESET IT.
20200		GO TO 123
20300	1251	CALL NOIR(RMINI)
20310	C  FOR QUARTER NOTES ON PLOTTER.
20400		GO TO 123
20500	
20600	125	IF(PLT)GO TO 1251
20700		KL=17
20800		RG=22.
21300	C   ABOVE IS NEW NOTES ROUTINE
21310	1253	CALL RDRAW(KL,RG,RNOTE,RMINI,R3,CENTR,RMINI)
21400	
21500	123	R5=R5-J5
21600	C  R5=STEPS TO LEFT FOR ACCID. (.1=1 STEP)
21700		IF(STEM.EQ.0)GO TO 1242
21800		IF(L.LT.300)RB=CENTR+RZTM
21850	C************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ +2
21900	C  ≥300 IS FOR 'X' NOTES.
22000	128	J7=MOD(J7,10)
22100		RG=(J7-1)*14
22200		IF(RG)RG=0
22270	CC	IF(R8.EQ.999)R8=0
22275	C 999 IS STANDARD (0) STEM LENGTH.
22280		IF(R8.NE.999)GO TO 1751
22285		R8=0
22290		RH=0
22295		GO TO 2751
22300	1751	IF(R8.LT.999)GO TO 751
22375		R8=R8-1000.
22387		J10=1
22393	C  1000+ PUTS SLASH ON NOTE STEM
22500	751	RH=R8*RST7
22600	C  STEM EXTENSIONS ARE BY NOTE #S
22700	2751	IF(STEM.NE.2)GO TO 1280
22800		RJX=R3
22900	C  FOR STEM DOWN (=2)
23000		RG=-RG-48.
23100		RH=-RH
23200		L=20
23750		RB=RB-RZTM*2
23755	C  FOR TILT OF ORDINARY NOTES (NOT X OR DIAMOND)
23760	C************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ SEE 21800  12/74
23800		GO TO 129
23900	C  NEXT IS FOR STEM UP.
24000	1280	RJX=RSTM
24420		IF(J6.EQ.0)GO TO 2322
24500		IF(J6.NE.30)RJX=16.2
24600	C  FOR HALF NOTES
24700	2322	RJX=RJX*RMINI+R3
24800		RG=RG+48.
24900		L=10
25200	129	RZ=CENTR+RH+RG*RMINI
25300		IF(RMINI.NE.RSTJ2)RJW=RJW*.6
25400		CALL LINX(RJX,RB,RJX,RZ)
25500	C  RB HERE IS CENTR (FOR 'X' NOTES OR NOT)
25600	227	J5=J5-L
25700	C   J5 HAS ACCID. # NOW
25800		IF(J7.EQ.0)GO TO 1242
25810	C   JUMP IF NO TAILS
25820		RJW=2.*RMINI/RSTJ2
25830	C  FOR VERT. SPACING OF MULTIPLE TAILS
25910		IF(STEM.NE.2)GO TO 1127
25920		R4=R4-3.7-R8
25930	C R4 IS USED IN SUBR. TAIL   - R8 IS STEM EXTENSION.
25940		RJW=-RJW
25950		RA=1.
25960		GO TO 127
25984	1127	R4=R4-2+R8
25991	C  2 ABOVE AND 3.7 BEFORE ARE BECAUSE ORIG. POS. OF TAIL DRWING IS OFF.
25996		RA=-1.
25998		R8=0
25999	C  ↑↑↑↑↑↑ FOR SHIFT AT 246
26000	127	CALL TAIL(RJX,RA,RMINI)
26100	1028	J7=J7-1
26200		IF(J7.EQ.0)GO TO 327
26300		R4=R4+RJW
26400	C  MOVES CENTR UP OR DOWN FOR NEXT TAIL
26500		GO TO 127
26562	327	IF(R4.GE.RX4)RX4=R4+1
26570	CC327	IF(R4.GE.RJZ)RJZ=R4+1
26575	C  FOR TRILLS, ETC.
26600		IF(J10.EQ.0)GO TO 1242
26700		RJY=RZ-19*RSTJ2
26800		RZ=RZ-RSTJ2*4.
26900		IF(RA.LT.0)GO TO 1327
27000	C  NEXT IS FOR STEM DOWN SLASH
27100		RJY=RZ+23*RSTJ2
27200		RZ=RZ+RST7
27300	1327	RJX=RJX-RST7
27400		CALL LINX(RJX,RJY,RJX+17.*RSTJ2,RZ)
27500	C  FOR SLASH ON GRACE NOTE TAIL
27600	1242	IF(R7.LT.10.)GO TO 1342
27700	C  FOR DOTTED NOTE-- P7>9 
27800		RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
27850	C***↑↑↑↑↑  WAS 24.  11/74
27900		RJY=CENTR+RSTJ2
28000		IF(JY.EQ.10)GO TO 4322
28050	 	IF(JY.NE.30)GO TO 3322
28075	4322	RJX=RJX+RSTM
28100	C  MOVES DOT TO LEFT
28200	3322	IF(MOD(J4,2).EQ.0)GO TO 108
28300		RX=RST7
28400		IF(JY.GE.20)RX=-RX
28500	3342	RJY=RJY+RX
28600		GO TO 108
28700	C  JY=30= STEM UP, INTERVAL OF SECOND.
28710	1342	IF(J5.NE.0)GO TO 5322
28755		IF(R6.EQ.0)RETURN
28800	5322	R3=R3-R5*59.6*RMINI
28900	C  TO SPACE OUT ACCIDS.
29000	CCXX	IF(RMINI.NE.RSTJ2)RSTJ2=.7*RSTJ2
29100	C   ↑↑↑↑		  ↑↑↑↑↑ WAS RMINI
29200	C********* 18/9/72
29300	242	IF(J5.GE.0)GO TO 2421
29400		RINV=-RINV
29500		J5=-J5
29600	C  NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
29700	C********** LAST # WAS 281?
29800	C b,#,NAT, ACC ∧, ACC >, FERMATA, DOT, REP MEAS., DASH
29900	CXX 11/74 2421	RH=14
29910	2421	J5X=-1
29920		JAX=JA
29960	C  USED AT 4241  FOR DOUBLE MARKS ON NOTES.
30000		IF(JA.EQ.9)GO TO 2423
30010		IF(J5.GT.3)GO TO 3121
30020	C  DBL FLT(4) AND DBL SHRP(5)  ALWAYS USE 'DRAW' ROUTINE.
30030		GO TO 211
30050	2423	RJZ=AMOD(R4,100.)
30075	C  FOR 'DRWNT' WHEN PLOTTING.
30100		CALL NOZERO(R6)
30200	C  R6=SIZE FACTOR  (P6)
30300		RMINI=RMINI*R6
30400		R6=0
30500		STEM=0
30600	C   FOR MISC. ITEMS
30700	210	IF(IABS(J4).LT.100)GO TO 1241
30710	CC210	IF(IABS(J4).LT.100)GO TO 3241
30800		J4=MOD(J4,100)
30900		RMINI=.7*RMINI
31000	CC3421	J5X=-1
31100	C FOR 2 MARKS AT ONCE.
31200	1241	IF(J5.GE.11)GO TO 28
31300		GO TO (211,211,211,28,28,222,249,60,27,27),J5
31400		RETURN
31500	C  ERROR TRAP (I.E. J5=0)
31510	C  FOR 1 OR 2 BAR REP SIGNS.
31555	60	CALL BREP(R3,RSTJ2)
31577		RETURN
31600	
31700	241	CALL LINES(R3,CENTR,3)
31800		GO TO 210
31805	
31900	
31910	211	IF(J5.EQ.0)GO TO 2422
31917	C  GETS BACK GOOD VERTICAL POS.
31920		IF(J5.GT.3)GO TO 222
31930	C  FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
31940		IF(PLT)GO TO 3121
31945		IF(JFONT.NE.0)GO TO 3121
31950		X=NACCI(J5)
31960		CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,R3,CENTR,RMINI)
32000	2422	IF(R6.EQ.0)RETURN
32004		J5=(R6+.001)*100.
32010		R4=RX4
32020	CC	R4=RJZ
32100		R3=RJAC
32300	1249	IF(MOD(J5,10).GT.3)GO TO 249
32400		J5=J5/10
32500		IF(J5.GT.30)GO TO 1249
32600	C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
32700	249	IF(J5.GT.30)GO TO 28
32800		IF(J5.GT.10)GO TO 246
32850		IF(J5.EQ.0)RETURN
32900		IF(JA.NE.1)GO TO 250
33000	CXX 11/74	RH=8
33100		RB=14.
33110		IF(MOD(J4,2).EQ.0)GO TO 244
33200		IF(J5.EQ.7)GO TO 6322
33250		IF(J5.NE.9)GO TO 244
33300	6322	IF(STEM.GT.1)GO TO 7322
33310		IF(J4.LT.5)GO TO 244
33320	7322	IF(J4.LE.9)GO TO 8322
33330		IF(STEM.EQ.2)GO TO 244
33340		IF(STEM.EQ.0)GO TO 244
33500	8322	RB=21
33600	C   PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
33700	244	IF(STEM.EQ.1)GO TO 9322
33710		IF(STEM.NE.0)GO TO 245
33720		IF(J4.GE.7)GO TO 245
33730	9322	RB=-RB
33800	CC	IF(J5.NE.6)GO TO 245
33900	CC	IF(J4.LT.9.AND.STEM.EQ.2)GO TO 281
34000	CC	IF(J4.GT.4.AND.STEM.EQ.1)GO TO 252
34100	245	CENTR=CENTR+RB*RSTX
34200	250	IF(J5.GT.10)GO TO 281
34210		IF(J5.LT.6)GO TO 281
34300		JA=9
34400		IF(J5.NE.7)GO TO 253
34500	C   7=DOT
34600		RXX=R3
34700		R3=R3+6.7*RMINI
34800	C  CENTERS THE DOT
34900		GO TO 29
35000	253	IF(J5.EQ.9)GO TO 271
35100	C   9=DASH
35200	251	IF(RB.LT.0)RINV=-RINV
35300	C   FIX THIS!!!!  FOR BOWINGS, ETC.
35310	2222	IF(J5.NE.20)GO TO 2223
35315	CZZZZZZZZZZZ
35320		JA=7
35330		R5=0
35340		J7=1
35350		CALL ALPHA
35360	C  FOR TRILL  -- J5=20
35370		RETURN
35380	2223	IF(J5.EQ.17)GO TO 323
35385		IF(J5.NE.18)GO TO 222
35387	323	RINV=J5
35390	C  FOR MORD, INV.MORD
35400	222	CALL FERMTA(RINV)
35500		GO TO 5241
35600	252	RX=POS
35700	248	CENTR=RX
35800		GO TO 251
35900	246	IF(J5.LT.10)GO TO 245
36000		R4=R4+3
36100		IF(STEM.EQ.1)R4=R4+6.+R8
36200		IF(R4.LT.12.5)R4=12.5
36300		CALL CENTX
36400		IF(J5.EQ.26)GO TO 222
36500	C  26 IS NEW NUMB FOR FERMATA.
36700	28	IF(J5.LT.30)GO TO 281
36800		J5X=MOD(J5,10)
36900	C  J5X SAVES NEXT MARK.
37000		IF(J5X.LT.4)J5X=0
37100		J5=J5/10
37200		IF(J5.GT.30)RETURN
37300	C  WON'T READ 415 ETC. (CORRECT=154)
37400	C DOES BOTTOM MARK FIRST, THEN TOP.
37500		CALL EXCH(J5X,J5)
37600	C  PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
37700		IF(JA.EQ.1)GO TO 249
37800		GO TO 1241
37900	281	X=1
37950		IF(J5.GT.16)GO TO 2222
37975	C  JUMP FOR MORD, INV.MORD, TRILL
38000		IF(J5.NE.4)GO TO 228
38100		X=5
38200		CALL RJBX(.5)
38300		GO TO 328
38400	228	IF(J5.GT.10)X=XAC(J5-10)
38500	C   X IS POINTER IN RACNT ARRAY
38600	328	RA=RMINI
38700	C   OR RSTJ2?
38800		IF(RINV.LT.0)GO TO 1323
38810		IF(STEM.NE.1)GO TO 2323
38820		IF(J5.NE.4)GO TO 2323
38830	1323	RA=-RA
38850	C  ↓↓↓ X ↓↓↓ PICKS UP TYPO ERRORS
38900	2323	IF(X.LT.54)CALL RDRAW(X+1,RACNT(X),RACNT,RA,R3,CENTR,RMINI)
39000	C              PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
39100	C  IN ARRAY, 33.012 WOULD BE X=33, Y=12.  101.123 IS X=-1, Y=-23.
39200		GO TO 5241
39300	4241	JJJ=J5
39400		J5=J5X
39500		J5X=-1
39600		IF(JAX.NE.1)GO TO 7241
39700		IF(J5.GT.10)GO TO 246
39800		IF(J5.NE.7)GO TO 7241
39810		IF(JJJ.NE.9)GO TO 249
39900	7241	RXX=8.5*RMINI
39950	C↑↑↑↑↑↑  11/74  WAS RH*
40000		IF(STEM.EQ.1)RXX=-RXX
40100		CENTR=CENTR+RXX
40200		IF(J5.EQ.26)J5=6
40300	C  TEMPORARY?? FIX
40400		GO TO 1241
40500	C >=5,  ∧=4
40600	27	R3=J3
40700	C  DASHES
40800	271	CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
40850	C    ****   ****    ***  ↑↑↑↑↑↑↑↑↑↑ THIS WAS RSTJ2 11/74
40900	5241	IF(J5X.GT.0)GO TO 4241
41000	C J5X IS FOR DOUBLE MARKS.  (WHAT ABOUT DOT POSITION.)
41100		RETURN
41200	6241	R3=RXX
41300	C  RESET R3 AFTER A DOT.
41400		GO TO 5241
42010	3121	J5=J5+9
42015	C  SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
42020	C  TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
42030		CALL DRWNT(RMINI)
42040		GO TO 2422
50200		END